import System.Random


data (Num a, Fractional a, Ord a) => Node a = Node [a] [a] | Nil
	deriving (Show, Eq)

type Sequence a = [Node a]


zeros :: Num a => Int -> [a]
zeros 0 = []
zeros n = [0] ++ zeros (n - 1)


addToList :: Num a => a -> [a] -> [a]
addToList _ [] = []
addToList n (x : xs) = (n + x) : addToList n xs


initState :: Num a => Int -> [a]
initState 0 = []
initState n = (head alf) : initState (n - 1)


rk0 :: Num a => [a]
rk0 = initState (length coef)


coef :: (Num a, Fractional a, Ord a) => [a]
coef = [1, 0.4, 0.5, -1.1, 1, 0.2]


alf :: Num a => [a]
alf = [-1, 1]


extGetPos :: Num a => Int -> a -> Int
extGetPos i n
	| n == (at i alf) = i
	| otherwise = extGetPos (i + 1) n

getPos :: Num a => a -> Int
getPos n = extGetPos 0 n


getOrder :: Num a => [a] -> Int
getOrder [] = 0
getOrder (x : xs) = (getPos x) * ((length alf) ^ (length xs)) + getOrder xs 


numOfNodes :: Int
numOfNodes = (length alf) ^ (length coef)


fillState :: Num a => [a] -> [a]
fillState state
	| (length state) < (length coef) = fillState ((head alf) : state)
	| otherwise = state


genState :: (Num a, Fractional a, Ord a) => Int -> [a]
genState n
	| n < (length alf) = [at n alf]
	| otherwise = genState (div n (length alf)) ++ genState (mod n (length alf))


nodeWeight :: (Num a, Fractional a, Ord a) => Node a -> a
nodeWeight (Node state cost) = at (smaller cost) cost


weight :: (Num a, Fractional a, Ord a) => Int -> [Node a] -> a
weight i stage = nodeWeight (at i stage)


extGetAdjacent :: (Num a, Fractional a, Ord a) => [a] -> [Node a] -> [a] -> [a]
extGetAdjacent _ _ [] = []
extGetAdjacent state stage (x : xs) = weight node stage : extGetAdjacent state stage xs
	where
		node = getOrder (invShift x state)

getAdjacent :: (Num a, Fractional a, Ord a) => [a] -> [Node a] -> [a]
getAdjacent state stage = extGetAdjacent state stage alf


extGenStage :: (Num a, Fractional a, Ord a) => Int -> [Node a] -> [Node a]
extGenStage i []
	| i < numOfNodes = [Node state zeroWeight] ++ extGenStage (i + 1) []
	| otherwise = []
		where
			state = fillState (genState i)
			zeroWeight = zeros (length alf)
extGenStage i stage
	| i < numOfNodes = [Node state oldWeight] ++ extGenStage (i + 1) stage
	| otherwise = []
		where
			state = fillState (genState i)
			oldWeight = getAdjacent state stage					

genStage :: (Num a, Fractional a, Ord a) => [Node a] -> [Node a]
genStage stage = extGenStage 0 stage


initStage :: (Num a, Fractional a, Ord a) => [Node a]
initStage = genStage []


setStage :: (Num a, Fractional a, Ord a) => a -> [Node a] -> [Node a]
setStage r [] = []
setStage r (n : ns) = (setNode r n) : setStage r ns


setNode :: (Num a, Fractional a, Ord a) => a -> Node a -> Node a
setNode r (Node state cost) = Node state (dist r cost state)


dist :: (Num a, Fractional a, Ord a) => a -> [a] -> [a] -> [a]
dist r [] _ = []
dist r (x : xs) state = (x + (sqDist r (pp state coef))) : dist r xs state
	

equals :: Num a => [a] -> [a] -> Bool
equals [] [] = True
equals (x : xs) (y : ys) = and ((x == y) : [equals xs ys])


rand :: Num a => [a]
rand = [-1, 1, 1, -1, 1, -1]


extAt :: Int -> Int -> [a] -> a
extAt i pos (x : xs)
	| i == pos = x
	| otherwise = extAt (i+1) pos xs

at :: Int -> [a] -> a
at pos l = extAt 0 pos l


pp :: Num a => [a] -> [a] -> a
pp [] [] = 0
pp _ [] = error "[Scalar Product: Different size vectors]"
pp [] _ = error "[Scalar Product: Different size vectors]"
pp (x : xs) (y : ys) = (x * y) + pp xs ys


sqDist :: (Num a, Fractional a, Ord a) => a -> a -> a
sqDist x y = (x - y) ^ 2


extSmaller :: (Num a, Ord a) => Int -> Int -> a -> [a] -> Int
extSmaller pos i n [] = pos
extSmaller pos i n (x : xs)
	| i == 0 = extSmaller i (i+1) x xs
	| n <= x = extSmaller pos (i+1) n xs
	| otherwise = extSmaller i (i+1) x xs

smaller :: (Num a, Ord a) => [a] -> Int
smaller [] = error "Empty list!"
smaller l = extSmaller 0 0 0 l


shift :: Num a => a -> [a] -> [a]
shift ak [] = [ak]
shift ak (x : xs) = xs ++ [ak]


invShift :: Num a => a -> [a] -> [a]
invShift ak l = reverse (shift ak (reverse l))


extTrellis :: (Num a, Fractional a, Ord a) => [a] -> [[Node a]] -> [[Node a]]
extTrellis [] t = t
extTrellis (x : xs) t = extTrellis xs (setStage x (head t) : t)

trellis :: (Num a, Fractional a, Ord a) => [a] -> [[Node a]]
trellis sim = extTrellis sim [initStage]


sim :: (Num a, Fractional a, Ord a) => [a] -> [a] -> [a]      
sim rk [] = []                                                
sim rk (x : xs) = [pp (shift x rk) coef] ++ sim (shift x rk) xs


start :: (Num a, Fractional a, Ord a) => [a] -> [a]
start r = sim rk0 r


main = print (start rand)


